home *** CD-ROM | disk | FTP | other *** search
/ Belgian Amiga Club - ADF Collection / BS1 part 34.zip / BS1 part 34 / FredFish PD 308.adf / StarBlanker / src / Mess.mod < prev    next >
Text File  |  1990-01-18  |  2KB  |  74 lines
  1. IMPLEMENTATION MODULE Mess;
  2.  
  3. FROM DOSProcess        IMPORT    Delay;
  4. FROM RunTime        IMPORT    GfxBase;
  5. FROM GfxBase        IMPORT    GfxBaseRecPtr;
  6. FROM SYSTEM        IMPORT    ADR, BYTE;
  7. FROM Pens        IMPORT    RectFill, Move, SetAPen, SetBPen;
  8. FROM Text        IMPORT    Text;
  9. FROM Intuition        IMPORT    OpenWindow, WBenchScreen, WindowFlagSet,
  10.                 WindowFlags, IDCMPFlagSet, CloseWindow,
  11.                 NewWindow, WindowPtr, SmartRefresh;
  12.  
  13. (*$S-*)
  14. PROCEDURE LengthStr(str:ARRAY OF CHAR): CARDINAL;
  15. VAR
  16.   i : INTEGER;
  17. BEGIN
  18.   i:=-1;
  19.   REPEAT
  20.     INC(i);
  21.   UNTIL (str[i]=0C) OR (i>INTEGER(HIGH(str)));
  22.  
  23.   RETURN i;
  24. END LengthStr;
  25.  
  26. (*$S-*)
  27. PROCEDURE SayMessage(text : ARRAY OF CHAR);
  28. VAR NWindow : NewWindow;
  29.     wp : WindowPtr;
  30.     gb : GfxBaseRecPtr;
  31.     width : CARDINAL;
  32.     left : CARDINAL;
  33.     len  : CARDINAL;
  34. BEGIN
  35.     len := LengthStr(text);
  36.     gb := GfxBase;
  37.     width := len * 8 + 8;   
  38.  
  39.     left := (CARDINAL(gb^.NormalDisplayColumns) - width) DIV 2;
  40.  
  41.     WITH NWindow DO
  42.       LeftEdge := left; TopEdge := 30;
  43.       Width := width;  Height := 13;
  44.       BlockPen := BYTE (0); DetailPen := BYTE (0);
  45.       Title := NIL;
  46.       Flags := WindowFlagSet {Borderless,NoCareRefresh}+SmartRefresh;
  47.       IDCMPFlags := IDCMPFlagSet{};
  48.       CheckMark := NIL;
  49.       FirstGadget := NIL; 
  50.       CheckMark := NIL; Screen := NIL;
  51.       Type := WBenchScreen; BitMap := NIL;
  52.       MinWidth := -1; MinHeight := -1;
  53.       MaxWidth := -1; MaxHeight := -1;
  54.     END;
  55.  
  56.     (* Open the window *)
  57.     wp := OpenWindow(ADR(NWindow));
  58.     IF wp # NIL THEN
  59.       SetBPen(wp^.RPort,1);
  60.       SetAPen(wp^.RPort,2);
  61.       RectFill(wp^.RPort,0,0,wp^.Width-1,wp^.Height-1);
  62.       SetAPen(wp^.RPort,1);
  63.       RectFill(wp^.RPort,2,1,wp^.Width-3,wp^.Height-2);
  64.       Move(wp^.RPort,5,9);
  65.       SetAPen(wp^.RPort,0);
  66.       Text(wp^.RPort,ADR(text),len);
  67.       Delay(80);
  68.       CloseWindow(wp);
  69.     END;
  70.  
  71. END SayMessage;
  72.  
  73. END Mess.
  74.